home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr28 / logcopy.zip / SETCOPY.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-26  |  18KB  |  527 lines
  1. (* N *)
  2. (*$include:'SETDIR.INT'*)
  3. (*$include:'SETDOS.INT'*)
  4. (*$include:'SETGRAPH.INT'*)
  5.  
  6. (**********************************************************************)
  7. (*  Setcopy program for use with logcopy.  Manages database that log  *)
  8. (*  copy reads in when invoked.                                       *)
  9. (**********************************************************************)
  10.  
  11. Program Setcopy(input,output);
  12.   uses SETDIR,SETDOS,SETGRAPH;
  13.   Const
  14.     Program_name         = 'SETCOPY version 3.00 by Keith P. Robison';
  15.     Copyright            = 'copyright Syracuse University 1988';
  16.     data_drive           = '^';
  17.     data_path            = 'SYS:PUBLIC';
  18.     data_filename        = data_drive*':LOG©.DAT';
  19.     max_programs         = 100;
  20.     program_name_length  = 80;
  21.     server_name_length   = 48;
  22.  
  23.     VER = 'VeRsIoN=SETCOPY Version 3.00 by Keith P. Robison'*chr(0)*'$';
  24.   Type
  25.     pointers_type = Array [1 .. max_programs] of Word;
  26.     program_info  = Record
  27.                       Copies : Byte;
  28.                       logit  : Byte;
  29.                       name   : Lstring(program_name_length);
  30.                       server : Lstring(server_name_length);
  31.                     End;
  32.     programs_type = Array [1 .. max_programs] of program_info;
  33.  
  34.   Var
  35.     pointer : pointers_type;
  36.     info    : programs_type;
  37.     count   : Integer;
  38.     fout    : file of byte;
  39.     fin     : file of byte;
  40.     version : Lstring(80);
  41.     logging : Boolean;
  42.  
  43.   Value
  44.     version := VER;
  45.     logging := FALSE;
  46.  
  47. (**********************************************************************)
  48. (*                                                                    *)
  49. (*                                                                    *)
  50. (**********************************************************************)
  51.  
  52.   Procedure cls;
  53.     Begin
  54.       scroll_screen_up(0,0,0,24,79,31);
  55.       gotoxy(0,0);
  56.     End; (* cls *)
  57.  
  58. (**********************************************************************)
  59. (*                                                                    *)
  60. (*                                                                    *)
  61. (**********************************************************************)
  62.  
  63.   Procedure key_press;
  64.     Begin
  65.       gotoxy(24,20);
  66.       Write('Press ENTER to continue');
  67.       readln;
  68.     End; (* key_press *)
  69.  
  70. (**********************************************************************)
  71. (*                                                                    *)
  72. (*                                                                    *)
  73. (**********************************************************************)
  74.  
  75.   Procedure upper_case(Var s : Lstring);
  76.     Var
  77.       i : Integer;
  78.     Begin
  79.       if s.len > 0 then for i:= 1 to ord(s.len) Do
  80.         if (s[i] >= 'a') and (s[i] <= 'z') Then s[i]:=chr(ord(s[i])-32);
  81.     End; (* upper_case *)
  82.  
  83. (**********************************************************************)
  84. (*                                                                    *)
  85. (*                                                                    *)
  86. (**********************************************************************)
  87.  
  88.   Procedure Calc_pointers;
  89.     Var
  90.       i : Integer;
  91.     Begin
  92.       pointer[1]:=wrd(count*2+2);
  93.       if count > 1 Then
  94.         for i:= 2 to count Do
  95.           pointer[i]:=pointer[i-1]+3+info[i-1].name.len+1+
  96.             info[i-1].server.len;
  97.     End; (* Calc_pointers *)
  98.  
  99. (**********************************************************************)
  100. (*                                                                    *)
  101. (*                                                                    *)
  102. (**********************************************************************)
  103.  
  104.   Procedure write_pointers;
  105.     Var
  106.       i : Integer;
  107.     Begin
  108.       if count > 0 Then
  109.         for i:= 1 to count do
  110.           write(fout,lobyte(pointer[i]),hibyte(pointer[i]));
  111.       Write(fout,0,0);
  112.     End; (* write_pointers *)
  113.  
  114. (**********************************************************************)
  115. (*                                                                    *)
  116. (*                                                                    *)
  117. (**********************************************************************)
  118.  
  119.   Procedure write_info;
  120.     Var
  121.       i,j : Integer;
  122.     Begin
  123.       for i:= 1 to count do
  124.         Begin
  125.           write(fout,info[i].copies,info[i].logit,info[i].name.len);
  126.           if info[i].name.len > 0 Then
  127.             for j:= 1 to ord(info[i].name.len) Do
  128.               Write(fout,wrd(info[i].name[j]));
  129.           write(fout,info[i].server.len);
  130.           if info[i].server.len > 0 Then
  131.             for j:= 1 to ord(info[i].server.len) Do
  132.               Write(fout,wrd(info[i].server[j]));
  133.         End;
  134.     End; (* write_info *)
  135.  
  136. (**********************************************************************)
  137. (*                                                                    *)
  138. (*                                                                    *)
  139. (**********************************************************************)
  140.  
  141.   Procedure read_pointers;
  142.     Var
  143.       bl,bh : Byte;
  144.     Begin
  145.       count:=0;
  146.       Repeat
  147.         count:=count+1;
  148.         Read(fin,bl,bh);
  149.         pointer[count]:=byword(bh,bl);
  150.       Until pointer[count] = 0;
  151.       count:=count-1;
  152.     End; (* read_pointers *)
  153.  
  154. (**********************************************************************)
  155. (*                                                                    *)
  156. (*                                                                    *)
  157. (**********************************************************************)
  158.  
  159.   Procedure read_info;
  160.     Var
  161.       i,j : Integer;
  162.       b   : Byte;
  163.     Begin
  164.       for i:= 1 to count Do
  165.         Begin
  166.           read(fin,info[i].copies,info[i].logit,info[i].name.len);
  167.           if info[i].name.len > 0 Then
  168.             for j:= 1 to ord(info[i].name.len) Do
  169.               Begin
  170.                 read(fin,b);
  171.                 info[i].name[j]:=chr(b);
  172.               End;
  173.           read(fin,info[i].server.len);
  174.           if info[i].name.len > 0 Then
  175.             for j:= 1 to ord(info[i].server.len) Do
  176.               Begin
  177.                 read(fin,b);
  178.                 info[i].server[j]:=chr(b);
  179.               End;
  180.         End;
  181.     End; (* read_info *)
  182.  
  183. (**********************************************************************)
  184. (*                                                                    *)
  185. (*                                                                    *)
  186. (**********************************************************************)
  187.  
  188.   Procedure read_file;
  189.     Var
  190.       b : Byte;
  191.     Begin
  192.       assign(fin,data_filename);
  193.       fin.trap:=TRUE;
  194.       reset(fin);
  195.       if fin.errs = 0 Then
  196.         Begin
  197.           read(fin,b);
  198.           If b = 0 then logging:=TRUE
  199.           Else if b = 255 then logging:=FALSE;
  200.           read_pointers;
  201.           read_info;
  202.           close(fin);
  203.         End;
  204.     End; (* read_file *)
  205.  
  206. (**********************************************************************)
  207. (*                                                                    *)
  208. (*                                                                    *)
  209. (**********************************************************************)
  210.  
  211.   Procedure write_file;
  212.     Var
  213.       temp : Lstring(64);
  214.       rc   : Integer;
  215.     Begin
  216.       assign(fout,data_filename);
  217.       fin.trap:=TRUE;
  218.       rewrite(fout);
  219.       if fout.errs = 0 Then
  220.         Begin
  221.           if logging then write(fout,0)
  222.           Else write(fout,255);
  223.           calc_pointers;
  224.           write_pointers;
  225.           write_info;
  226.           close(fout);
  227.           copylst(data_filename,temp);
  228.           concat(temp,chr(0));
  229.           rc:=attrib(ads temp,128);
  230.         End
  231.       Else writeln('Unable to write file');
  232.     End; (* Write_file *)
  233.  
  234. (**********************************************************************)
  235. (*                                                                    *)
  236. (*                                                                    *)
  237. (**********************************************************************)
  238.  
  239.   Procedure initialize;
  240.     Var
  241.       rc   : Integer;
  242.       base : Integer;
  243.       mask : integer;
  244.     Begin
  245.       rc:=net_alloc_temp_base(data_drive,0,data_path,base,mask);
  246.       count:=0;
  247.     End; (* initialize *)
  248.  
  249.  
  250. (**********************************************************************)
  251. (*                                                                    *)
  252. (*                                                                    *)
  253. (**********************************************************************)
  254.  
  255.   Procedure add_item;
  256.     Var
  257.       ch : Char;
  258.     Begin
  259.       cls;
  260.       count:=count+1;
  261.       Write('Enter program name:');
  262.       readln(info[count].name);
  263.       upper_case(info[count].name);
  264.       Write('Log executions ? (Y/N):');
  265.       readln(ch);
  266.       if ch in ['Y','y'] Then info[count].logit:=0
  267.       Else info[count].logit:=1;
  268.       Write('Limited number of copies ? (Y/N) :');
  269.       readln(ch);
  270.       if ch in ['Y','y'] Then
  271.         Begin
  272.           Write('How Many Copies:');
  273.           readln(info[count].copies);
  274.           Write('Enter Server:');
  275.           readln(info[count].server);
  276.           upper_case(info[count].server);
  277.         End
  278.       Else
  279.         Begin
  280.           info[count].copies:=0;
  281.           info[count].server.len:=0;
  282.         End;
  283.       key_press;
  284.     End; (* add_item *)
  285.  
  286. (**********************************************************************)
  287. (*                                                                    *)
  288. (*                                                                    *)
  289. (**********************************************************************)
  290.  
  291.  Procedure change_logging;
  292.    Begin
  293.      cls;
  294.      gotoxy(12,10);
  295.      if logging then
  296.        Begin
  297.          logging:=FALSE;
  298.          Writeln('Default logging set to OFF');
  299.        End
  300.      Else
  301.        Begin
  302.          logging:=TRUE;
  303.          Writeln('Default logging set to ON');
  304.        End;
  305.      key_press;
  306.    End; (* change_logging *)
  307.  
  308. (**********************************************************************)
  309. (*                                                                    *)
  310. (*                                                                    *)
  311. (**********************************************************************)
  312.  
  313.   Procedure delete_item;
  314.     Var
  315.       item : Integer;
  316.       i,j  : Integer;
  317.     Begin
  318.       cls;
  319.       Writeln;
  320.       Write('Enter number of item to delete (0=Quit):');
  321.       Readln(item);
  322.       if item > 0 then
  323.         Begin
  324.           if item <> count then
  325.             for i:= item+1 to count do info[i-1]:=info[i];
  326.           count:=count-1;
  327.         End;
  328.       key_press;
  329.     End; (* delete_item *)
  330.  
  331. (**********************************************************************)
  332. (*                                                                    *)
  333. (*                                                                    *)
  334. (**********************************************************************)
  335.  
  336.   Procedure list_items;
  337.     Var
  338.       i    : Integer;
  339.       temp : Lstring(80);
  340.     Begin
  341.       cls;
  342.       Writeln;
  343.       writeln('Item ',' ':20,'Program Name',' ':12,'Logging  Copies  Server');
  344.       for i:= 1 to 80 do temp[i]:='=';
  345.       temp.len:=80;
  346.       Write(temp);
  347.       if count = 0 then writeln('File is empty or does not exist')
  348.       Else for i:= 1 to count do
  349.         Begin
  350.           write(i:3,' | ',info[i].name:40,'  |');
  351.           if info[i].logit = 1 then write('   OFF  ')
  352.           Else write('   ON   ');
  353.           If info[i].copies = 0 then write('|  ALL  ')
  354.           Else write('|  ',info[i].copies:3,'  ');
  355.           if info[i].server.len > 0 then write('| ',info[i].server)
  356.           Else write('|');
  357.           Writeln;
  358.         End;
  359.       Write(temp);
  360.       key_press;
  361.     End; (* list_items *)
  362.  
  363. (**********************************************************************)
  364. (*                                                                    *)
  365. (*                                                                    *)
  366. (**********************************************************************)
  367.  
  368.   Procedure modify_item;
  369.     Var
  370.       ch : Char;
  371.       item : Integer;
  372.       i,j  : Integer;
  373.       temp : Lstring(80);
  374.     Begin
  375.       cls;
  376.       Writeln;
  377.       Write('Enter number of item to modify (0=Quit):');
  378.       Readln(item);
  379.       if (item > 0) and (item <= count) then
  380.         Begin
  381.           write('Item ',' ':20,'Program Name',' ':12);
  382.           writeln('Logging  Copies  Server');
  383.           for i:= 1 to 80 do temp[i]:='=';
  384.           temp.len:=80;
  385.           Write(temp);
  386.           write(item:3,' | ',info[item].name:40,'  |');
  387.           if info[item].logit = 1 then write('   OFF  ')
  388.           Else write('   ON   ');
  389.           If info[item].copies = 0 then write('|  ALL  ')
  390.           Else write('|  ',info[item].copies:3,'  ');
  391.           if info[item].server.len > 0 then write('| ',info[item].server)
  392.           Else write('|');
  393.           Writeln;
  394.           Write(temp);
  395.           Writeln;
  396.           Write('Enter program name [',info[item].name,']:');
  397.           readln(temp);
  398.           if temp.len > 0 then copylst(temp,info[item].name);
  399.           upper_case(info[item].name);
  400.           Write('Log executions ? (Y/N) [');
  401.           if info[item].logit=0 then write('Y]:')
  402.           Else write('N]:');
  403.           readln(temp);
  404.           if temp.len > 0 then
  405.             Begin
  406.               ch:=temp[1];
  407.               if ch in ['Y','y'] Then info[item].logit:=0
  408.               Else info[item].logit:=1;
  409.             End;
  410.           Write('Limited number of copies ? (Y/N) [');
  411.           if info[item].copies > 0 then write('Y]:')
  412.           Else write('N]:');
  413.           readln(temp);
  414.           if temp.len > 0 then ch:=temp[1]
  415.           Else
  416.             Begin
  417.               if  info[item].copies > 0 then ch:= 'Y'
  418.               Else ch:='N'
  419.             End;
  420.           if ch in ['Y','y'] Then
  421.             Begin
  422.               Write('How Many Copies [',info[item].copies:3,']:');
  423.               readln(temp);
  424.               if temp.len > 0 then
  425.                 Begin
  426.                   if NOT decode(temp,info[item].copies) Then
  427.                   info[item].copies:=0;
  428.                 End;
  429.               if info[item].copies > 0 Then
  430.                 Begin
  431.                   Write('Enter Server [',info[item].server,']:');
  432.                   readln(temp);
  433.                   if temp.len > 0 then copylst(temp,info[item].server);
  434.                   while (info[item].server.len > 0 ) and
  435.                     (info[item].server[1]=' ') do
  436.                       delete(info[item].server,1,1);
  437.                   upper_case(info[item].server);
  438.                 End;
  439.             End
  440.           Else
  441.             Begin
  442.               info[item].copies:=0;
  443.               info[item].server.len:=0;
  444.            End;
  445.         End;
  446.       key_press;
  447.     End; (* Modify_item *)
  448.  
  449. (**********************************************************************)
  450. (*                                                                    *)
  451. (*                                                                    *)
  452. (**********************************************************************)
  453.  
  454.   Procedure exit;
  455.     Begin
  456.       write_file;
  457.     End;
  458.  
  459. (**********************************************************************)
  460. (*                                                                    *)
  461. (*                                                                    *)
  462. (**********************************************************************)
  463.  
  464.   Procedure quit;
  465.     Begin
  466.     End;
  467.  
  468. (**********************************************************************)
  469. (*                                                                    *)
  470. (*                                                                    *)
  471. (**********************************************************************)
  472.  
  473.   Procedure menu;
  474.     Var
  475.       s  : Lstring(1);
  476.       ch : Char;
  477.     Begin
  478.       Repeat
  479.         cls;
  480.         Writeln(program_name);
  481.         Writeln(copyright);
  482.         Writeln;
  483.         Writeln;
  484.         Write('Default logging is ');
  485.         if logging then Writeln('ON') Else Writeln('OFF');
  486.         Writeln;
  487.         Writeln('A)dd a item');
  488.         Writeln('C)hanged default logging');
  489.         Writeln('D)elete an item');
  490.         Writeln('L)ist items');
  491.     Writeln('M)odify an item');
  492.         Writeln;
  493.         Writeln('Q)uit and Do NOT update file');
  494.         Writeln('E)xit and update file');
  495.         Writeln;
  496.         Write('Enter letter of choice :');
  497.         readln(s);
  498.         If s.len > 0 then
  499.           Begin
  500.             ch := s[1];
  501.             writeln;
  502.             Case ch of
  503.               'A','a' : add_item;
  504.               'C','c' : change_logging;
  505.               'D','d' : delete_item;
  506.               'E','e' : exit;
  507.               'L','l' : list_items;
  508.               'M','m' : modify_item;
  509.               'Q','q' : quit;
  510.               otherwise;
  511.             End;
  512.           End;
  513.       Until ch in ['q','Q','e','E']
  514.     End;
  515.  
  516. (**********************************************************************)
  517. (*                                                                    *)
  518. (*                                                                    *)
  519. (**********************************************************************)
  520.  
  521. Begin
  522.   initialize;
  523.   read_file;
  524.   menu;
  525. End.
  526. (* O *)
  527.